Prevod na text bez diakritiky
Otázka od: Dalibor
14. 11. 2003 9:31
Ahoj, nemate nekdo napsanou funkci na prevod textu na text bez diakritiky?
----------
* www.inMail.sk - Vasa emailova adresa na cely zivot ZDARMA
* Mail neobsahuje virusy. Zkontrolovane antivirusom NOD32 (www.eset.sk)
* www.SlovakNET.sk - profesionalny webhosting, domena .SK ZADARMO
* Zoner Media Explorer 5 - stiahnite si pomocnika pre digitalnu fotografiu
(zme.zoner.sk)
Odpovedá: Alexandr Stefek
14. 11. 2003 10:33
> Ahoj, nemate nekdo napsanou funkci na prevod textu na text bez
diakritiky?
>
Je v Synapsi
----------
* www.inMail.sk - Vasa emailova adresa na cely zivot ZDARMA
* Mail neobsahuje virusy. Zkontrolovane antivirusom NOD32 (www.eset.sk)
* www.SlovakNET.sk - profesionalny webhosting, domena .SK ZADARMO
* Zoner Media Explorer 5 - stiahnite si pomocnika pre digitalnu fotografiu
(zme.zoner.sk)
Odpovedá: kexo
14. 11. 2003 10:40
helou, ak ti ide o prevod win1250->ascii, tak nech sa paci, procedura na
konverziu 2 suborov:
type
CodeTable=array[$80..$FF] of byte;
TBuff= array[1..100000] of byte;
const
_1250ToAsc:CodeTable=
($da,$da,$2c,$da,$22,$5f,$2b,$2b,$da,$25,$53,$3c,$53,$54,$5a,$5a,
$da,$27,$27,$22,$22,$2e,$2d,$2d,$da,$7e,$73,$3e,$73,$74,$7a,$7a,
$20,$7e,$7e,$4c,$2a,$41,$7c,$f5,$22,$40,$53,$3c,$2d,$2d,$40,$5a,
$27,$2b,$2e,$6c,$27,$75,$71,$27,$2e,$61,$73,$3e,$4c,$22,$6c,$7a,
$52,$41,$41,$41,$41,$4c,$43,$43,$43,$45,$45,$45,$45,$49,$49,$44,
$44,$4e,$4e,$4f,$4f,$4f,$4f,$78,$52,$55,$55,$55,$55,$59,$54,$42,
$72,$61,$61,$61,$61,$6c,$63,$63,$63,$65,$65,$65,$65,$69,$69,$64,
$64,$6e,$6e,$6f,$6f,$6f,$6f,$2f,$72,$75,$75,$75,$75,$79,$74,$27);
var
Buff:^Tbuff;
f1,f2:file of byte;
procedure C1ToC2(CT:CodeTable);
var i:integer;
br:integer
begin
repeat
BlockRead(f1,buff^,sizeof(Tbuff),br);
for i:=1 to br do
if buff[i]>$7f then buff[i]:=CT[buff[i]];
BlockWrite(f2,buff^,br);
until br<>SizeOf(TBuff);
end;
a potom volanie:
C1ToC2(_1250ToAsc);
----- Original Message -----
From: "Dalibor" <dalibor@torola.cz>
To: <delphi-l@clexpert.cz>
Sent: Friday, November 14, 2003 9:20 AM
Subject: Prevod na text bez diakritiky
> Ahoj, nemate nekdo napsanou funkci na prevod textu na text bez
diakritiky?
>
----------
* www.inMail.sk - Vasa emailova adresa na cely zivot ZDARMA
* Mail neobsahuje virusy. Zkontrolovane antivirusom NOD32 (www.eset.sk)
* www.SlovakNET.sk - profesionalny webhosting, domena .SK ZADARMO
* Zoner Media Explorer 5 - stiahnite si pomocnika pre digitalnu fotografiu
(zme.zoner.sk)
Odpovedá: Michal Kuncl
14. 11. 2003 18:29
Dalibor wrote:
> Ahoj, nemate nekdo napsanou funkci na prevod textu na text bez
diakritiky?
>
>
>
Sice to neni nic moc, je to jen pro kodovani win-1250, ale snad to aspon
trochu pomuze ... Tteda za predpokladu ze z tohohle mailu neco
neorizne hacky a carky 
zdravi
Spider_X
function BezCestiny(I:string):string;
var s:string;
begin
s:=i;
strReplace(s,'e(','e');
strReplace(s,'?','s');
strReplace(s,'c(','c');
strReplace(s,'r(','r');
strReplace(s,'?','z');
strReplace(s,'y','y');
strReplace(s,'a','a');
strReplace(s,'i','i');
strReplace(s,'e','e');
strReplace(s,'u','u');
strReplace(s,'u*','u');
strReplace(s,'o','o');
strReplace(s,'n(','n');
strReplace(s,'t(','t');
strReplace(s,'d(','d');
//
strReplace(s,'E(','E');
strReplace(s,'?','S');
strReplace(s,'C(','C');
strReplace(s,'R(','R');
strReplace(s,'?','Z');
strReplace(s,'Y','Y');
strReplace(s,'A','A');
strReplace(s,'I','I');
strReplace(s,'E','E');
strReplace(s,'U','U');
strReplace(s,'O','O');
strReplace(s,'N(','N');
strReplace(s,'T(','T');
strReplace(s,'D(','D');
//
result:=s;
end;
// procedura na nahrazovani jednoho textoveho retezce druhym
procedure strReplace(var S:String; const Source, Dest: String);
var hs,hs1,hs2,hs3: String;
var i,j : integer;
begin
hs:= UpperCase(s);
hs3 := UpperCase(Source);
hs1:= '';
I:= pos(hs3,hs);
j := length(hs3);
while i > 0 do
begin
delete(hs,1,i+j-1);
hs1 := Hs1+copy(s,1,i-1);
delete(s,1,i-1);
hs2 := copy(s,1,j);
delete(s,1,j);
hs1 := hs1+dest;
I:=pos(hs3,hs);
end;
s:=hs1+s;
end;
----------
* www.inMail.sk - Vasa emailova adresa na cely zivot ZDARMA
* Mail neobsahuje virusy. Zkontrolovane antivirusom NOD32 (www.eset.sk)
* www.SlovakNET.sk - profesionalny webhosting, domena .SK ZADARMO
* Zoner Media Explorer 5 - stiahnite si pomocnika pre digitalnu fotografiu
(zme.zoner.sk)